{ TODO : при изменении процентов изменять размеры }

unit ToggleBoxContainer;

{$mode objfpc}{$H+}

interface

uses
  Classes, SysUtils, LResources, Forms, Controls, Graphics, Dialogs, ExtCtrls;

type

  { TToggleBoxContainer }

  TToggleBoxContainer = class(TPanel)
  private
    FUserOnClick: TNotifyEvent;
    FChecked: boolean;
    FColorChecked: TColor;
    FColorUnChecked: TColor;
    FPercentage: integer;
    FShape: TShape;
    FBoxes: TList;
    FStartPercent: integer;
    function GetBox(AIndex: integer): TToggleBoxContainer;
    function GetBoxCount: integer;
    procedure SetChecked(const AValue: boolean);
    procedure SetPercentage(const AValue: integer);
    procedure SetStartPercent(const AValue: integer);
  protected
    { Protected declarations }
  public
    { Public declarations }
    constructor Create(TheOwner: TComponent); override;
    procedure MClick(Sender: TObject);

    function AddBox(startpercent, percent: integer; acaption: TCaption = ''): TToggleBoxContainer;
    property Boxes[Index: integer]: TToggleBoxContainer read GetBox;
    property BoxCount: integer read GetBoxCount;
    procedure SetChecked(Sender: TToggleBoxContainer);
    function FindBox(AName: string): TToggleBoxContainer;
    function FindBoxByCaption(AName: string): TToggleBoxContainer;
  published
    { Published declarations }
    property Checked: boolean read FChecked write SetChecked;// default false;
    property ColorChecked: TColor read FColorChecked write FColorChecked;// default clBlue;
    property ColorUnChecked: TColor read FColorUnChecked write FColorUnChecked;// default clGray;
    property StartPercent: integer read FStartPercent write SetStartPercent;
    property Percentage: integer read FPercentage write SetPercentage;
    property OnClick read FUserOnClick write FUserOnClick;
//    property BevelOuter default bvNone;

  end;

procedure Register;

implementation

procedure Register;
begin
  RegisterComponents('Additional',[TToggleBoxContainer]);
end;

{ TToggleBoxContainer }

procedure TToggleBoxContainer.SetChecked(const AValue: boolean);
var
  i: integer;
begin
  if FChecked=AValue then exit;
  if AValue then
  begin
    for i := 0 to BoxCount - 1 do
      Boxes[i].SetChecked(self);
    if HasParent and (Parent.ClassType = TToggleBoxContainer) then
      TToggleBoxContainer(Parent).SetChecked(self);
    FShape.Pen.Color := FColorChecked;
  end
  else
    FShape.Pen.Color := FColorUnChecked;
  FChecked:=AValue;
end;

procedure TToggleBoxContainer.SetPercentage(const AValue: integer);
begin
  if FPercentage=AValue then exit;
  FPercentage:=AValue;
end;

procedure TToggleBoxContainer.SetStartPercent(const AValue: integer);
begin
  if FStartPercent=AValue then exit;
  FStartPercent:=AValue;
end;

function TToggleBoxContainer.GetBox(AIndex: integer): TToggleBoxContainer;
begin
  If not assigned(FBoxes) then
    Result:=Nil
  else
    Result:=TToggleBoxContainer(FBoxes.Items[Aindex]);
end;

function TToggleBoxContainer.GetBoxCount: integer;
begin
  result := FBoxes.Count;
end;

constructor TToggleBoxContainer.Create(TheOwner: TComponent);
begin
  inherited Create(TheOwner);

  FBoxes := TList.Create;
  FShape := TShape.Create(self);
  FShape.Parent := self;

  Checked := false;
  ColorChecked := clBlue;
  ColorUnChecked := clGray;
  BevelOuter := bvSpace;
//  BevelInner:=bvNone;
  BorderStyle := bsNone;
  FShape.Align := alClient;
  FShape.Brush.Color := clSilver;
  FShape.Pen.Color := FColorUnChecked;
  FShape.Pen.Width := 3;
  if color = clDefault then
    Font.Color := ColorToRGB(GetDefaultColor(dctBrush))
  else
    Font.Color := color;
  FShape.OnClick := @MClick;
  inherited OnClick := @MClick;
//  FShape.DesignInfo := self.DesignInfo;
//  FShape.ComponentState := self.ComponentState;
end;

procedure TToggleBoxContainer.MClick(Sender: TObject);
begin
  Checked := true;
  if Assigned(FUserOnClick) then
    FUserOnClick(self);
end;

function TToggleBoxContainer.AddBox(startpercent, percent: integer; acaption: TCaption = ''): TToggleBoxContainer;
var
  tb: TToggleBoxContainer;
begin
  tb := TToggleBoxContainer.Create(self);
  FBoxes.Add(tb);

  tb.Parent := self;
  tb.StartPercent := startpercent;
  tb.Percentage := percent;
  tb.Top := FShape.Pen.Width + 1;
  tb.Height := self.Height - FShape.Pen.Width * 2 - 2;
  tb.Left := FShape.Pen.Width + round(startpercent * (self.Width - FShape.Pen.Width * 2) / 100) + 1;
  tb.Width := round(percent * (self.Width - FShape.Pen.Width * 2) / 100) -2;
  Result := tb;
end;

procedure TToggleBoxContainer.SetChecked(Sender: TToggleBoxContainer);
var
  i: integer;
begin
  for i := 0 to BoxCount - 1 do
    if Boxes[i] <> sender then
      Boxes[i].SetChecked(self);
  if HasParent and (Parent.ClassType = TToggleBoxContainer) and (Parent <> Sender) then
    TToggleBoxContainer(Parent).SetChecked(self);
  FShape.Pen.Color := FColorUnChecked;
  FChecked:=false;
end;

function TToggleBoxContainer.FindBox(AName: string): TToggleBoxContainer;
var
  i: integer;
  tb: TToggleBoxContainer;
begin
  if CompareText(Name, AName) = 0 then
    Exit(self);

  for i := 0 to BoxCount -1 do
    begin
      tb := Boxes[i].FindBox(AName);
      if tb <> nil then
        exit(tb)
      else
        if CompareText(Boxes[i].Name, AName) = 0 then
          Exit(Boxes[i]);
    end;

  Result := nil;
end;

function TToggleBoxContainer.FindBoxByCaption(AName: string
  ): TToggleBoxContainer;
var
  i: integer;
  tb: TToggleBoxContainer;
begin
  if CompareText(Caption, AName) = 0 then
    Exit(self);

  for i := 0 to BoxCount -1 do
    begin
      tb := Boxes[i].FindBoxByCaption(AName);
      if  tb <> nil then
        exit(tb)
      else
        if CompareText(Boxes[i].Caption, AName) = 0 then
          Exit(Boxes[i]);
    end;

  Result := nil;
end;

end.
